; The MIT License
; 
; Copyright (c) 2008 Christophe Grand
; 
; Permission is hereby granted, free of charge, to any person obtaining a copy
; of this software and associated documentation files (the "Software"), to deal
; in the Software without restriction, including without limitation the rights
; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
; copies of the Software, and to permit persons to whom the Software is
; furnished to do so, subject to the following conditions:
; 
; The above copyright notice and this permission notice shall be included in
; all copies or substantial portions of the Software.
; 
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
; THE SOFTWARE

; This file provides infrastructure for building templating systems.

(in-ns 'template.Writer)
(clojure/refer 'clojure :only '(gen-and-load-class defn))
(try
	(gen-and-load-class 'template.Writer :extends java.io.Writer :constructors {[clojure.lang.IFn] []} :init 'init :state 'w)
	(catch java.lang.LinkageError e))
(defn init [writer] [[] writer])
(defn write-String [#^template.Writer this s] ((. this w) s)) 
(defn write-char<>-int-int [#^template.Writer this #^"[C" cb #^Integer off #^Integer len] ((. this w) (new String cb off len)))
(defn write-String-int-int [#^template.Writer this #^String s #^Integer off #^Integer len] ((. this w) (new String s off len)))

(clojure/in-ns 'template)
(clojure/refer 'clojure)

(defmacro def-
  "same as def, yielding non-public def"
  [name & decls]
    (list* `def (with-meta name (assoc (meta name) :private true)) decls))

(def #^java.io.Writer *raw-out*)
(def *escaping*)
(defn write-unesc
  "write (str x) without escaping"
  [x] (.write *raw-out* (str x)))
(defn write 
  "write (str x) with the current escaping"
  [x] (.write *raw-out* (*escaping* (str x))))
(def esc-writer (new template.Writer write))

(defmacro with-escaping [esc & etc]
	`(binding [*escaping* ~esc] ~@etc))

(defmacro with-raw-out
  [out & etc] 	
	`(binding [*raw-out* ~out, *escaping* identity, *out* esc-writer] 
			~@etc))

(defmacro nest [& etc]
	`(let [out# *raw-out*, esc# *escaping*]
		(with-raw-out (new template.Writer (fn [x#] (.write out# (esc# (str x#))))) ~@etc)))

(defn- static-write-unesc? [[op arg & etc]]
	(and (= op `write-unesc) (string? arg) (nil? etc)))

(defn- static-write? [[op arg & etc]]
	(and (= op `write) (string? arg) (nil? etc)))

(defn- symbol-write-unesc? [[op arg & etc]]
	(and (= op `write-unesc) (symbol? arg) (nil? etc)))

(defn- symbol-write? [[op arg & etc]]
	(and (= op `write) (symbol? arg) (nil? etc)))

(defn merge-writes [s]
	(if s
		(let [[writes etc] (split-with static-write-unesc? s)]
			(if writes
				(lazy-cons `(write-unesc ~(apply str (map second writes))) (merge-writes etc))
				(lazy-cons (first etc) (merge-writes (rest etc)))))))

(defn seq-first [s]
	(if (seq? s)
		(let [x (first s)]
			(if-let {:keys [name ns]} (and (symbol? x) (not (namespace x)) (meta (resolve x))) 
				(symbol (str (ns-name ns)) (str name))
				x)) 
		nil))

(defmulti 
 #^{:doc "Apply one simplification (rewrite) to the form. Dispatch according to the head. 
          Each method is a rewrite rule."
    :arglists '([form])} 
  simplify-1 seq-first nil)
  
(defn simplify
  "Apply all known simplifications to the form.
   It macroexpands the form if it allows to perform some simplifications." 
  [form]
    (let [sform (simplify-1 form)]
      (if (= form sform)
        (let [exform (macroexpand-1 form)]
          (if (= form exform)
            form
            (let [sform (simplify-1 exform)]
              (if (= sform exform)
                form
                sform))))
        (recur sform))))

(defmethod simplify-1 nil [form]
	form)

(defn wrap*
  "wrap the forms in a DO form if there's more than one form else return this single form"
  [forms]
    (if (rest forms)
	  `(do ~@forms)
      (first forms)))

(defn wrap
  "wrap and simplify the forms in a DO form if there's more than one form else return this single form"
  ([form & etc] (wrap (cons form etc))) 
  ([forms]
    (simplify (if (rest forms)
	            `(do ~@forms)
                (first forms)))))

(defn simplify-body
  "Helper function which simplify a seq of forms as found in a DO form."
  [body]
    (let [collapse-do (fn [[op & etc :as form]] (if (= 'do op) etc (list form)))
          collapsed (mapcat collapse-do (map simplify body))
          merged (merge-writes collapsed)]
      merged))
		
(defmethod simplify-1 `do [[op & body]]
	(wrap* (simplify-body body)))
	
(defn- trim-with [pred coll]
	(let [[pre mid] (split-with pred coll)
			[post mid] (split-with pred (reverse mid))]
		[pre (reverse mid) (reverse post)]))

(defn- simplify-and-trim [coll rewrite trim-pred reform]
	(let [coll (simplify-body coll)
			coll (map rewrite coll)
			[pre mid post] (trim-with trim-pred coll)]
		(cond
			(= mid coll)
				(reform coll)
			mid
				`(do
					~@pre
					~(reform mid)
					~@post)
			:else
				(wrap* coll))))

(def- *current-escaping* nil) 
(defmethod simplify-1 `with-escaping [[op esc & etc]]
	(if (= esc *current-escaping*)
		(wrap* (simplify-body etc))
		(binding [*current-escaping* esc]
			(simplify-and-trim etc 
				(if (symbol? esc)
					(let [f (find-var esc)]	#(cond 
												(static-write? %) `(write-unesc ~(f (second %)))
												(symbol-write? %) (with-meta `(write-unesc (~esc (str ~(second %)))) {:html2/no-side-effects true})
												:else %))
					identity)
				#(or (static-write-unesc? %) (= `with-escaping (first %)) (:html2/no-side-effects (meta %)))
				(fn [x] `(with-escaping ~esc ~@x)))))) 

(def
 #^{:doc "the current template processing rules"} 
  *process*)

(defn process-coll
  "helper function for processing a collection of templates"
  [x] (wrap (map *process* x))) 

(defmacro def-process-fn
  "Defines a function suitable for processing templates. Its argument is tested 
  against the conds.
  If no cond succeed, it defaults to: embedding seqs and symbols, calling 
  process-coll on vectors and calling str on anything else."
  [name x & conds]
  	`(defn ~name [~x] 
      (binding [*process* ~name]
        (simplify 
          (cond
          	~@conds
            (vector? ~x) (process-coll ~x) 
            (seq? ~x) `(write ~~x)
            (symbol? ~x) `(write ~~x)
            :else `(write ~(str ~x)))))))

(def-process-fn default-process x)